home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / games / blackbox.el next >
Encoding:
Text File  |  1995-03-25  |  14.5 KB  |  438 lines
  1. ;;; blackbox.el --- blackbox game in Emacs Lisp
  2.  
  3. ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
  4.  
  5. ;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
  6. ;; Adapted-By: ESR
  7. ;; Keywords: games
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. ;;; Synched up with: FSF 19.28.
  26.  
  27. ;;; Commentary:
  28.  
  29. ; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
  30. ; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89
  31. ; interface improvements by ESR, Dec 5 1991.
  32.  
  33. ; The object of the game is to find four hidden balls by shooting rays
  34. ; into the black box.  There are four possibilities: 1) the ray will
  35. ; pass thru the box undisturbed, 2) it will hit a ball and be absorbed,
  36. ; 3) it will be deflected and exit the box, or 4) be deflected immediately,
  37. ; not even being allowed entry into the box.
  38. ; 
  39. ; The strange part is the method of deflection.  It seems that rays will
  40. ; not pass next to a ball, and change direction at right angles to avoid it.
  41. ; 
  42. ;                      R   3   
  43. ;          1 - - - - - - - - 1 
  44. ;            - - - - - - - -   
  45. ;            - O - - - - - - 3 
  46. ;          2 - - - - O - O -   
  47. ;          4 - - - - - - - - 
  48. ;          5 - - - - - - - - 5 
  49. ;            - - - - - - - - R 
  50. ;          H - - - - - - - O   
  51. ;            2   H 4       H   
  52. ; 
  53. ; Rays which enter and exit are numbered.  You can see that rays 1 & 5 pass
  54. ; thru the box undisturbed. Ray 2 is deflected by the northwesternmost
  55. ; ball.  Likewise rays 3 and 4. Rays which hit balls and are absorbed are
  56. ; marked with H.  The bottom of the left and the right of the bottom hit
  57. ; the southeastern ball directly.  Rays may also hit balls after being
  58. ; reflected. Consider the H on the bottom next to the 4.  It bounces off
  59. ; the NW-ern most ball and hits the central ball.  A ray shot from above
  60. ; the right side 5 would hit the SE-ern most ball.  The R beneath the 5
  61. ; is because the ball is returned instantly.  It is not allowed into
  62. ; the box if it would reflect immediately.  The R on the top is a more
  63. ; leisurely return.  Both central balls would tend to deflect it east
  64. ; or west, but it cannot go either way, so it just retreats.
  65. ;
  66. ; At the end of the game, if you've placed guesses for as many balls as
  67. ; there are in the box, the true board position will be revealed.  Each
  68. ; `x' is an incorrect guess of yours; `o' is the true location of a ball.
  69.  
  70. ;;; Code:
  71.  
  72. (defvar blackbox-mode-map nil "")
  73.  
  74. (if blackbox-mode-map
  75.     ()
  76.   (setq blackbox-mode-map (make-keymap))
  77.   (suppress-keymap blackbox-mode-map t)
  78.   (define-key blackbox-mode-map "\C-f" 'bb-right)
  79.   (define-key blackbox-mode-map [right] 'bb-right)
  80.   (define-key blackbox-mode-map "\C-b" 'bb-left)
  81.   (define-key blackbox-mode-map [left] 'bb-left)
  82.   (define-key blackbox-mode-map "\C-p" 'bb-up)
  83.   (define-key blackbox-mode-map [up] 'bb-up)
  84.   (define-key blackbox-mode-map "\C-n" 'bb-down)
  85.   (define-key blackbox-mode-map [down] 'bb-down)
  86.   (define-key blackbox-mode-map "\C-e" 'bb-eol)
  87.   (define-key blackbox-mode-map "\C-a" 'bb-bol)
  88.   (define-key blackbox-mode-map " " 'bb-romp)
  89.   (define-key blackbox-mode-map [insert] 'bb-romp)
  90.   (define-key blackbox-mode-map "\C-m" 'bb-done)
  91.   (define-key blackbox-mode-map [kp_enter] 'bb-done))
  92.  
  93. ;; Blackbox mode is suitable only for specially formatted data.
  94. (put 'blackbox-mode 'mode-class 'special)
  95.  
  96. (defvar bb-board)
  97. (defvar bb-balls-placed)
  98. (defvar bb-x)
  99. (defvar bb-y)
  100. (defvar bb-score)
  101. (defvar bb-detour-count)
  102.  
  103. (defun blackbox-mode ()
  104.   "Major mode for playing blackbox.  To learn how to play blackbox,
  105. see the documentation for function `blackbox'.
  106.  
  107. The usual mnemonic keys move the cursor around the box.
  108. \\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively.
  109.  
  110. \\[bb-romp] -- send in a ray from point, or toggle a ball at point
  111. \\[bb-done] -- end game and get score
  112. "
  113.   (interactive)
  114.   (kill-all-local-variables)
  115.   (use-local-map blackbox-mode-map)
  116.   (setq truncate-lines t)
  117.   (setq major-mode 'blackbox-mode)
  118.   (setq mode-name "Blackbox"))
  119.  
  120. ;;;###autoload
  121. (defun blackbox (num)
  122.   "Play blackbox.  Optional prefix argument is the number of balls;
  123. the default is 4.
  124.  
  125. What is blackbox?
  126.  
  127. Blackbox is a game of hide and seek played on an 8 by 8 grid (the
  128. Blackbox).  Your opponent (Emacs, in this case) has hidden several
  129. balls (usually 4) within this box.  By shooting rays into the box and
  130. observing where they emerge it is possible to deduce the positions of
  131. the hidden balls.  The fewer rays you use to find the balls, the lower
  132. your score.
  133.  
  134. Overview of play:
  135.  
  136. \\<blackbox-mode-map>\
  137. To play blackbox, type \\[blackbox].  An optional prefix argument
  138. specifies the number of balls to be hidden in the box; the default is
  139. four.
  140.  
  141. The cursor can be moved around the box with the standard cursor
  142. movement keys.
  143.  
  144. To shoot a ray, move the cursor to the edge of the box and press SPC.
  145. The result will be determined and the playfield updated.
  146.  
  147. You may place or remove balls in the box by moving the cursor into the
  148. box and pressing \\[bb-romp].
  149.  
  150. When you think the configuration of balls you have placed is correct,
  151. press \\[bb-done].  You will be informed whether you are correct or
  152. not, and be given your score.  Your score is the number of letters and
  153. numbers around the outside of the box plus five for each incorrectly
  154. placed ball.  If you placed any balls incorrectly, they will be
  155. indicated with `x', and their actual positions indicated with `o'.
  156.  
  157. Details:
  158.  
  159. There are three possible outcomes for each ray you send into the box:
  160.  
  161.     Detour: the ray is deflected and emerges somewhere other than
  162.         where you sent it in.  On the playfield, detours are
  163.         denoted by matching pairs of numbers -- one where the
  164.         ray went in, and the other where it came out.
  165.  
  166.     Reflection: the ray is reflected and emerges in the same place
  167.         it was sent in.  On the playfield, reflections are
  168.         denoted by the letter `R'.
  169.  
  170.     Hit:    the ray strikes a ball directly and is absorbed.  It does
  171.         not emerge from the box.  On the playfield, hits are
  172.         denoted by the letter `H'.
  173.  
  174. The rules for how balls deflect rays are simple and are best shown by
  175. example.
  176.  
  177. As a ray approaches a ball it is deflected ninety degrees.  Rays can
  178. be deflected multiple times.  In the diagrams below, the dashes
  179. represent empty box locations and the letter `O' represents a ball.
  180. The entrance and exit points of each ray are marked with numbers as
  181. described under \"Detour\" above.  Note that the entrance and exit
  182. points are always interchangeable.  `*' denotes the path taken by the
  183. ray.
  184.  
  185. Note carefully the relative positions of the ball and the ninety
  186. degree deflection it causes.
  187.  
  188.     1                                            
  189.   - * - - - - - -         - - - - - - - -         - - - - - - - -       
  190.   - * - - - - - -         - - - - - - - -         - - - - - - - -       
  191. 1 * * - - - - - -         - - - - - - - -         - O - - - - O -       
  192.   - - O - - - - -         - - O - - - - -         - - * * * * - -
  193.   - - - - - - - -         - - - * * * * * 2     3 * * * - - * - -
  194.   - - - - - - - -         - - - * - - - -         - - - O - * - -      
  195.   - - - - - - - -         - - - * - - - -         - - - - * * - -       
  196.   - - - - - - - -         - - - * - - - -         - - - - * - O -       
  197.                                 2                         3
  198.  
  199. As mentioned above, a reflection occurs when a ray emerges from the same point
  200. it was sent in.  This can happen in several ways:
  201.  
  202.                                                                            
  203.   - - - - - - - -         - - - - - - - -          - - - - - - - -
  204.   - - - - O - - -         - - O - O - - -          - - - - - - - -
  205. R * * * * - - - -         - - - * - - - -          O - - - - - - -
  206.   - - - - O - - -         - - - * - - - -        R - - - - - - - -
  207.   - - - - - - - -         - - - * - - - -          - - - - - - - -
  208.   - - - - - - - -         - - - * - - - -          - - - - - - - -
  209.   - - - - - - - -       R * * * * - - - -          - - - - - - - -
  210.   - - - - - - - -         - - - - O - - -          - - - - - - - -
  211.  
  212. In the first example, the ray is deflected downwards by the upper
  213. ball, then left by the lower ball, and finally retraces its path to
  214. its point of origin.  The second example is similar.  The third
  215. example is a bit anomalous but can be rationalized by realizing the
  216. ray never gets a chance to get into the box.  Alternatively, the ray
  217. can be thought of as being deflected downwards and immediately
  218. emerging from the box.
  219.  
  220. A hit occurs when a ray runs straight into a ball:
  221.  
  222.   - - - - - - - -         - - - - - - - -          - - - - - - - -
  223.   - - - - - - - -         - - - - - - - -          - - - - O - - -
  224.   - - - - - - - -         - - - - O - - -        H * * * * - - - -
  225.   - - - - - - - -       H * * * * O - - -          - - - * - - - -
  226.   - - - - - - - -         - - - - O - - -          - - - O - - - -
  227. H * * * O - - - -         - - - - - - - -          - - - - - - - -
  228.   - - - - - - - -         - - - - - - - -          - - - - - - - -
  229.   - - - - - - - -         - - - - - - - -          - - - - - - - -
  230.  
  231. Be sure to compare the second example of a hit with the first example of
  232. a reflection."
  233.   (interactive "P")
  234.   (switch-to-buffer "*Blackbox*")
  235.   (blackbox-mode)
  236.   (setq buffer-read-only t)
  237.   (buffer-disable-undo (current-buffer))
  238.   (make-local-variable 'bb-board)
  239.   (setq bb-board (bb-init-board (or num 4)))
  240.   (make-local-variable 'bb-balls-placed)
  241.   (setq bb-balls-placed nil)
  242.   (make-local-variable 'bb-x)
  243.   (setq bb-x -1)
  244.   (make-local-variable 'bb-y)
  245.   (setq bb-y -1)
  246.   (make-local-variable 'bb-score)
  247.   (setq bb-score 0)
  248.   (make-local-variable 'bb-detour-count)
  249.   (setq bb-detour-count 0)
  250.   (bb-insert-board)
  251.   (bb-goto (cons bb-x bb-y)))
  252.  
  253. (defun bb-init-board (num-balls)
  254.   (random t)
  255.   (let (board pos)
  256.     (while (>= (setq num-balls (1- num-balls)) 0)
  257.       (while
  258.       (progn
  259.         (setq pos (cons (random 8) (random 8)))
  260.         (bb-member pos board)))
  261.       (setq board (cons pos board)))
  262.     board))
  263.  
  264. (defun bb-insert-board ()
  265.   (let (i (buffer-read-only nil))
  266.     (erase-buffer)
  267.     (insert "                     \n")
  268.     (setq i 8)
  269.     (while (>= (setq i (1- i)) 0)
  270.       (insert "   - - - - - - - -   \n"))
  271.     (insert "                     \n")
  272.     (insert (format "\nThere are %d balls in the box" (length bb-board)))
  273.     ))
  274.  
  275. (defun bb-right ()
  276.   (interactive)
  277.   (if (= bb-x 8)
  278.       ()
  279.     (forward-char 2)
  280.     (setq bb-x (1+ bb-x))))
  281.  
  282. (defun bb-left ()
  283.   (interactive)
  284.   (if (= bb-x -1)
  285.       ()
  286.     (backward-char 2)
  287.     (setq bb-x (1- bb-x))))
  288.  
  289. (defun bb-up ()
  290.   (interactive)
  291.   (if (= bb-y -1)
  292.       ()
  293.     (previous-line 1)
  294.     (setq bb-y (1- bb-y))))
  295.  
  296. (defun bb-down ()
  297.   (interactive)
  298.   (if (= bb-y 8)
  299.       ()
  300.     (next-line 1)
  301.     (setq bb-y (1+ bb-y))))
  302.  
  303. (defun bb-eol ()
  304.   (interactive)
  305.   (setq bb-x 8)
  306.   (bb-goto (cons bb-x bb-y)))
  307.  
  308. (defun bb-bol ()
  309.   (interactive)
  310.   (setq bb-x -1)
  311.   (bb-goto (cons bb-x bb-y)))
  312.  
  313. (defun bb-romp ()
  314.   (interactive)
  315.   (cond
  316.    ((and
  317.      (or (= bb-x -1) (= bb-x 8))
  318.      (or (= bb-y -1) (= bb-y 8))))
  319.    ((bb-outside-box bb-x bb-y)
  320.     (bb-trace-ray bb-x bb-y))
  321.    (t
  322.     (bb-place-ball bb-x bb-y))))
  323.  
  324. (defun bb-place-ball (x y)
  325.   (let ((coord (cons x y)))
  326.     (cond
  327.      ((bb-member coord bb-balls-placed)
  328.       (setq bb-balls-placed (bb-delete coord bb-balls-placed))
  329.       (bb-update-board "-"))
  330.      (t
  331.       (setq bb-balls-placed (cons coord bb-balls-placed))
  332.       (bb-update-board "O")))))
  333.  
  334. (defun bb-trace-ray (x y)
  335.   (let ((result (bb-trace-ray-2
  336.          t
  337.          x
  338.          (cond
  339.           ((= x -1) 1)
  340.           ((= x 8) -1)
  341.           (t 0))
  342.          y
  343.          (cond
  344.           ((= y -1) 1)
  345.           ((= y 8) -1)
  346.           (t 0)))))
  347.     (cond
  348.      ((eq result 'hit)
  349.       (bb-update-board "H")
  350.       (setq bb-score (1+ bb-score)))
  351.      ((equal result (cons x y))
  352.       (bb-update-board "R")
  353.       (setq bb-score (1+ bb-score)))
  354.      (t
  355.       (setq bb-detour-count (1+ bb-detour-count))
  356.       (bb-update-board (format "%d" bb-detour-count))
  357.       (save-excursion
  358.     (bb-goto result)
  359.     (bb-update-board (format "%d" bb-detour-count)))
  360.       (setq bb-score (+ bb-score 2))))))
  361.  
  362. (defun bb-trace-ray-2 (first x dx y dy)
  363.   (cond
  364.    ((and (not first)
  365.      (bb-outside-box x y))
  366.     (cons x y))
  367.    ((bb-member (cons (+ x dx) (+ y dy)) bb-board)
  368.     'hit)
  369.    ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board)
  370.     (bb-trace-ray-2 nil x (- dy) y (- dx)))
  371.    ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board)
  372.     (bb-trace-ray-2 nil x dy y dx))
  373.    (t
  374.     (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy))))
  375.  
  376. (defun bb-done ()
  377.   "Finish the game and report score."
  378.   (interactive)
  379.   (let (bogus-balls)
  380.     (cond
  381.      ((not (= (length bb-balls-placed) (length bb-board)))
  382.       (message "There %s %d hidden ball%s; you have placed %d."
  383.            (if (= (length bb-board) 1) "is" "are")
  384.            (length bb-board)
  385.            (if (= (length bb-board) 1) "" "s")
  386.            (length bb-balls-placed)))
  387.      (t
  388.       (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board))
  389.       (if (= bogus-balls 0)
  390.       (message "Right!  Your score is %d." bb-score)
  391.     (message "Oops!  You missed %d ball%s.  Your score is %d."
  392.          bogus-balls
  393.          (if (= bogus-balls 1) "" "s")
  394.          (+ bb-score (* 5 bogus-balls))))
  395.       (bb-goto '(-1 . -1))))))
  396.  
  397. (defun bb-show-bogus-balls (balls-placed board)
  398.   (bb-show-bogus-balls-2 balls-placed board "x")
  399.   (bb-show-bogus-balls-2 board balls-placed "o"))
  400.  
  401. (defun bb-show-bogus-balls-2 (list-1 list-2 c)
  402.   (cond
  403.    ((null list-1)
  404.     0)
  405.    ((bb-member (car list-1) list-2)
  406.     (bb-show-bogus-balls-2 (cdr list-1) list-2 c))
  407.    (t
  408.     (bb-goto (car list-1))
  409.     (bb-update-board c)
  410.     (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c)))))
  411.  
  412. (defun bb-outside-box (x y)
  413.   (or (= x -1) (= x 8) (= y -1) (= y 8)))
  414.  
  415. (defun bb-goto (pos)
  416.   (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26)))
  417.  
  418. (defun bb-update-board (c)
  419.   (let ((buffer-read-only nil))
  420.     (backward-char (1- (length c)))
  421.     (delete-char (length c))
  422.     (insert c)
  423.     (backward-char 1)))
  424.   
  425. (defun bb-member (elt list)
  426.   "Returns non-nil if ELT is an element of LIST."
  427.   (eval (cons 'or (mapcar (function (lambda (x) (equal x elt))) list))))
  428.  
  429. (defun bb-delete (item list)
  430.   "Deletes ITEM from LIST and returns a copy."
  431.   (cond
  432.    ((equal item (car list)) (cdr list))
  433.    (t (cons (car list) (bb-delete item (cdr list))))))
  434.  
  435. ;;; blackbox.el ends here
  436.  
  437.  
  438.